#!perl -w
###############################################################################
#
# Name: cvs-dup-eol-fixer
# Author: Steve Ebersole
#
# Description:
# Script to fix the bad end-of-line issues that sometimes occur after checking
# out Hibernate source from the sourceforge CVS where everything is essentially
# double-spaced.  What I found however, at least on my environment, was that
# this was actually caused by carriage returns even though my machine was a 
# windows box.  This script tries to cleanup the most common issues I saw with
# CR characters.
#
###############################################################################


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Subroutine prototypes...
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub parsedir($);
sub checkfile($);
sub fixfile($);

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Start main process
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# undefine the input line seperator to treat the entire file contents at the
# same time (i.e., as one big string)
undef($/);

open( REPORTFILEHANDLE, ">cvs-dup-eol-fixer.report" ) or die( "Unable to open report file" );

my $basedir = shift @ARGV;
print( REPORTFILEHANDLE "Using basedir : $basedir\n");

my @file_list = parsedir($basedir);

foreach $file_name (@file_list) {
    print( REPORTFILEHANDLE "Checking file [$file_name]\n" );
    if ( checkfile($file_name) ) {
        print( REPORTFILEHANDLE "    Need to fix file : $file_name\n" );
        fixfile($file_name);
    }
}

close(REPORTFILEHANDLE) or warn("Unable to close report file");



#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# This subroutine is essentially a recursive directory searcher.  It does also
# filter out anything from the CVS local admin dirs.
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub parsedir($) {
    my @results = ();
    my $dir = shift@_;
    opendir(DIRHANDLE, $dir) or die("Unable to open dir [$dir] for parsing");
    my @dir_contents = readdir(DIRHANDLE);
    closedir(DIRHANDLE) or warn("Unable to close dir [$dir]");

    foreach $element (@dir_contents) {
        if ( $element eq "." || $element eq ".." ) {
            # Nothing to do here...
        }
        elsif ($element =~ /CVS/) {
            # nothing to do here...
        }
        # assume no extension means a directory
        elsif ($element =~ /\./) {
            if ($element =~ /\.java/) {
                push( @results, "$dir/$element" );
            }
        }
        else {
            push( @results, parsedir("$dir/$element") );
        }
    }

    return @results;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# This subroutine basically checks to see if the file needs to be fixed, based
# mainly on the number of adjacent (i.e., repeating) cariage-return characters.
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub checkfile($) {
    my $file_name = shift @_;
    my $loop_count = 0;
    my $adj_cr_count = 0;
    my $line_count = 0;

    my $rtn = 0;

    open( INFILEHANDLE, "<$file_name" ) or die( "Unable to open file [$file_name] for check" );
    while (<INFILEHANDLE>) {
        if (/\r/g) {
            $rtn = 1;
            last;
        }
    }
    close( INFILEHANDLE );
    return $rtn;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# This is the subroutine where the file actually gets fixed.  It is also
# responsible for making sure files get backed up before doing the fix.
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub fixfile($) {
    my $file_name = shift @_;
    my $file_text = "";

    open( INFILEHANDLE, "<$file_name" ) or die( "Unable to open file [$file_name] for fix input" );
    while (<INFILEHANDLE>) {
        # first, remove any number of \r followed immediately by a \n
        s/\r+?\n/\n/g;
        # replace any double \r with a \n
        s/\r\r/\n/g;
        $file_text .= $_;
    }
    close( INFILEHANDLE );

    my $new_file_name = $file_name . ".old";
    rename( $file_name, $new_file_name );

    open( OUTFILEHANDLE, ">$file_name" ) or die( "Unable to open file [$file_name] for fix output" );
    print( OUTFILEHANDLE $file_text );
    close( OUTFILEHANDLE );
}

__END__
